perm filename S11A.F4[P11,LCS] blob sn#341661 filedate 1978-03-11 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00014 ENDMK
CāŠ—;
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  3/78 **********  SCORE FOR PDP11 **********  LELAND SMITH

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP11 SOUND 
C   GENERATION PROGRAM. (MUSIC 5 TYPE)
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,S3,SCANR AND SPRINT 
C   (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /INS/ INST(27),BG(60)
C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
C   F1=86  F15=100 (NO F16!)

      COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
     1 LN,ITYP,TPALN(4),JED /SAM/ISAM
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
      COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
     1 RDEV(27),IPT(27,31),XT(27),OTH(20,16)
     1 ,P1(27),COPY(30),IFM(80)
     1 ,INVIS(27)
      DIMENSION LIST(78),JNP(80)
C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
      COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
     1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
     1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
      COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
     1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
     1 ZZ,CHN,YY 
     1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
     1  /C/LPAR,IPRN,QX,IRTRO,INVRT,ICON,LCNT,
     1 IPAREN,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
     1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
      EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
      DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
      DATA IBLA/' '/,IXX/'X'/
     1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
     1 ,ISCA/'C','P','D','O','E','F','PX','G','S','A','T','B'/
CCC PLAY??? 1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
      LPAR=0
      IPRN=0
      QX=0.
      MOT=0
      IRTRO=-1 
      INVRT=-1
      ICON=-1
      LCNT=1
      IPAREN=0
      JZ=1  
      IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
      K=0
      IDALL=-1
      QTS=-1.
      KB=0  
      NWZ=1
      BNW(1)=0
      I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
      DO 127 K=1,77,3
127      LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
      NWX=0
      BY=-1
      DO 1128 K=1,KZY     
      INVIS(K)=0
      INST(K)=0
      CNT(K)=0
      RDEV(K)=0
C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
      NP(K)=0
      IQ(K)=0
      IPT(K,1)=0
      DO 1128 L=1,32    
1128   PCH(K,L)=0 

      ITYP=-1
      JED=-1
2112      TYPE 8002
      ACCEPT 8001,INNM,J
C**** INNM AND IFLNM SHOULD DBL PREC. ON PDP11 (FOR A4 FORMAT)
C**** ONLY UP TO 4 LETTERS IN FILE NAMES.
999      IF(INNM.NE.'EDIT')GO TO 3112
      JED=0
      GO TO 2112
C  'EDIT' GOES TO EDIT MODE
3112  IF(INNM.NE.'TYPE')GO TO 128
      ITYP=0
      IFLNM='TYPD'
C***************** OPEN AN OUTPUT FILE *********
      CALL OFILE(21,IFLNM)
      CALL READIT
C******* IS A5 AVAILABLE?? *************
8001      FORMAT(A4,I)
8002      FORMAT(' TYPE FILE NAME--  '$)

128      IF(INNM.NE.IBLA)IFLNM=INNM
C*********** OPEN AN INPUT FILE ******************
      CALL IFILE(23,IFLNM)
      SOS=-1
      IF(J.NE.0)SOS=0
C TYPE ANY NUMBER AFTER INPUT FILE NAME TO SUPRESS INPUT LISTING.

      CALL OFILE(1,'RUNIT')
C**** THIS WRITES A FILE NAMED 'RUNIT.DAT' ********
      CALL READIT
      END